home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SWAG / SWAGA_C / COMM.SWG / 0070_Serial Communications in Pascal.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  12KB  |  434 lines
  1.  
  2. {
  3. >     Ok... I have fifty million different modem units, sources, docs
  4. > I have not been able to get any where with any of them....  All i want
  5.  
  6. I remember being in your shoes a long time ago, my friend.  I haven't
  7. a Unit, per se, but here is _WORKING_ Pascal source (excuse the
  8. documentation style, I originally wrote the code in C) that compiles under
  9. TP 6.0.
  10.  
  11.   Written by Dave Jarvis.
  12.   
  13.   The purpose of this program is to do a simple communications protocol and 
  14.   demonstrate how Serial communications can be Serially driven. 
  15. } 
  16.  
  17. USES DOS, Crt; 
  18.  
  19. CONST 
  20.   COM1      = $3F8;    { Communications port 1 address.     } 
  21.   COM2      = $2F8;    { Communications port 2 address.     } 
  22.   THR       = $00;     { Transmitter holding register.      } 
  23.   RDR       = $00;     { Receiver data register.            } 
  24.   BRDL      = $00;     { Baud rate low divisor register.    } 
  25.   BRDH      = $01;     { Baud rate high divisor register.   } 
  26.   IER       = $01;     { Interrupt enable register.         } 
  27.   IIR       = $02;     { Interrupt identIFication register. } 
  28.   LCR       = $03;     { Line control register.             } 
  29.   MCR       = $04;     { Modem control register.            } 
  30.   LSR       = $05;     { Line status register.              } 
  31.   MSR       = $06;     { Modem status register.             } 
  32.  
  33.   SET_BAUD  = $80;     { DLAB.                              } 
  34.   CTS_DSR   = $30;     { Check for DSR and CTS in MSR.      } 
  35.   THREMPTY  = $20;     { Check for THR empty in LSR.        } 
  36.  
  37.   WORD7      = $02;    { Bits 0 and 1 when setting LCR.     } 
  38.   WORD8      = $03; 
  39.   BIT1       = $00;    { Bit 3 when setting LCR.            } 
  40.   BIT2       = $04; 
  41.   NONE       = $00;    { Bits 4, 5, and 6 when setting LCR. } 
  42.   EVEN       = $30; 
  43.   ODD        = $20; 
  44.  
  45.   INT_ENABL  = $0B;    { Tell UART to perform interrupts.   } 
  46.   PIC        = $20;    { Address of PIC.                    } 
  47.   PIC_CNTL   = $21;    { Address of PIC control register.   } 
  48.   IRQ4_MASK  = $EF;    { Mask for IRQ4.                     } 
  49.   COM_INT    = $0C;    { Communications interrupt to tap.   } 
  50.   EOI        = $20;    { End of interrupt signal for PIC.   } 
  51.   DATA_REC   = $01;    { Interrupt on data received.        } 
  52.   WRITE_CH   = $0E;    { Write character function.          } 
  53.  
  54.   XON_CH     = #$11;   { XON protocol control character.    } 
  55.   XOFF_CH    = #$13;   { XOFF protocol control character.   } 
  56.   EOT        = #$04;   { End of transmission character.     }
  57.  
  58.   MAX_BUFF   = 256;     { Maximum characters in the buffer.  }
  59.   BUFF_FULL  = 0.75;    { Buffer full @ 75% of MAX_BUFF.     }
  60.   BUFF_EMPT  = 0.50;    { Buffer empty @ 50% of MAX_BUFF.    }
  61.  
  62.   ERR        = -1;
  63.  
  64. TYPE
  65.   RecLinkPtr = ^Receive;
  66.  
  67.   Receive = RECORD
  68.               rec_char : CHAR;
  69.               Next     : RecLinkPtr;
  70.             End;
  71.  
  72. VAR
  73.   rec_buff,                  { Global linked list. } 
  74.   to_write   : RecLinkPtr; 
  75.   buff_Count : INTEGER;      { Number of characters in buffer.    } 
  76.   xon        : BOOLEAN;      { Enable send ability.               } 
  77.  
  78. PROCEDURE ShowUsage; 
  79. Begin 
  80.    WriteLn( 'Usage : TERMINAL <baud> <parity> <data bits> <stop bits>' ); 
  81.    WriteLn( 'Where : <baud> is any of 300, 1200, 2400, 9600;' ); 
  82.    WriteLn( '        <parity> is any of N, O, E;' ); 
  83.    WriteLn( '        <data bits> is either 7 or 8;' ); 
  84.    WriteLn( '        <stop bits> is either 1 or 2.' ); 
  85.  
  86.    Halt( 0 );
  87.  
  88. End; 
  89.  
  90. PROCEDURE setup( baud, parity, data_bits, stop_bits : INTEGER ); 
  91. VAR 
  92.   setup : INTEGER; 
  93.  
  94. Begin 
  95.   setup := parity;
  96.  
  97.  
  98.   { Set DLAB such that baud rate can be changed/set. } 
  99.   Port[ COM1 + LCR ] := SET_BAUD; 
  100.  
  101.   CASE baud OF 
  102.      300 : Begin 
  103.              Port[ COM1 + BRDL ] := $80; 
  104.              Port[ COM1 + BRDH ] := $01; 
  105.            End; 
  106.     1200 : Begin 
  107.              Port[ COM1 + BRDL ] := $60; 
  108.              Port[ COM1 + BRDH ] := $00; 
  109.            End; 
  110.     2400 : Begin 
  111.              Port[ COM1 + BRDL ] := $30; 
  112.              Port[ COM1 + BRDH ] := $00; 
  113.            End; 
  114.     9600 : Begin 
  115.              Port[ COM1 + BRDL ] := $0C; 
  116.              Port[ COM1 + BRDH ] := $00; 
  117.            End;
  118.     ELSE
  119.       ShowUsage;
  120.   End;
  121.  
  122.   CASE data_bits OF
  123.     7  : setup := setup OR WORD7;
  124.     8  : setup := setup OR WORD8;
  125.     ELSE
  126.       ShowUsage;
  127.   End;
  128.  
  129.   CASE stop_bits OF
  130.     1  : setup := setup OR BIT1;
  131.     2  : setup := setup OR BIT2;
  132.     ELSE
  133.       ShowUsage;
  134.   End;
  135.  
  136.   { Send final (calculated) setup Value to the communications port. }
  137.   Port[ COM1 + LCR ] := setup;
  138. End;
  139.  
  140. PROCEDURE add_char( ch : CHAR );
  141. Begin 
  142.   { IF the buffer is full, then sound the speaker twice -- toss char. } 
  143.   IF( buff_Count = MAX_BUFF ) THEN 
  144.   Begin 
  145.     Sound( 1000 ); 
  146.     Sound( 900 ); 
  147.     NoSound; 
  148.  
  149.     Exit; 
  150.   End; 
  151.  
  152.   { Store character in buffer. } 
  153.   rec_buff^.rec_char := ch; 
  154.  
  155.   { Point to next storage position. } 
  156.   rec_buff := rec_buff^.next; 
  157.  
  158.   { Increment number of characters in buffer. } 
  159.   INC( buff_Count ); 
  160. End; 
  161.  
  162. {$F+} 
  163. PROCEDURE receive_ch; INTERRUPT; 
  164. VAR 
  165.   ch : CHAR; 
  166.  
  167. Begin 
  168.   ch := CHAR(Port[ COM1 + RDR ]); 
  169.  
  170.   IF( ch = XON_CH ) THEN 
  171.     xon := TRUE 
  172.   ELSE IF( ch = XOFF_CH ) THEN 
  173.     xon := FALSE 
  174.   ELSE 
  175.     add_char( CHAR(ch) ); 
  176.  
  177.   { Send End of interrupt signal to PIC chip. } 
  178.   Port[ PIC ] := EOI; 
  179. End; 
  180. {$F-} 
  181.  
  182. PROCEDURE xmit( ch : CHAR ); 
  183. Begin 
  184.   Port[ COM1 + THR ] := INTEGER(ch); 
  185. End;
  186.  
  187. FUNCTION can_xmit : BOOLEAN;
  188. Begin
  189.   {  IF input characters can be sent, and the DSR, CTS and THREMPTY are
  190.      all set high, then the character read from keyboard can be sent.
  191.   }
  192.   IF( xon AND ((Port[ COM1 + MSR ] AND CTS_DSR)  = CTS_DSR) AND
  193.              ((Port[ COM1 + LSR ] AND THREMPTY) = THREMPTY) ) THEN
  194.     can_xmit := TRUE
  195.   ELSE
  196.     can_xmit := FALSE;
  197.  
  198. End;
  199.  
  200. PROCEDURE writech;
  201. Begin
  202.   Write( to_write^.rec_char );
  203.  
  204.   { Decrement the number of actual elements in the buffer. }
  205.   DEC( buff_Count );
  206.  
  207.   { Point to the next character to write (IF any are left). }
  208.   to_write := to_write^.next;
  209. End;
  210.  
  211. PROCEDURE send_string( s : STRING );
  212. VAR 
  213.   Count : INTEGER; 
  214.  
  215. Begin 
  216.   FOR Count := 1 TO Length( S ) DO 
  217.   Begin 
  218.     WHILE( NOT can_xmit ) DO 
  219.       ; 
  220.  
  221.     xmit( s[ Count ] ); 
  222.   End; 
  223. End; 
  224.  
  225. PROCEDURE Serial; 
  226. VAR 
  227.   ch       : CHAR;       { Character read from the keyboard.    } 
  228.   done,                  { Loop until done = TRUE.              } 
  229.   send_xon : BOOLEAN;    { TRUE IF XON character has been sent. } 
  230.  
  231. Begin 
  232.   done     := FALSE; 
  233.   send_xon := TRUE; 
  234.  
  235.   Repeat 
  236.     {  IF a character is in the keyboard buffer, and it can be sent to the 
  237.        UART, then read it from the keyboard buffer, and transmit it. 
  238.     } 
  239.     IF( can_xmit AND KeyPressed ) THEN 
  240.     Begin 
  241.       ch := ReadKey; 
  242.  
  243.       IF( ch = EOT ) THEN 
  244.         done := TRUE 
  245.       ELSE 
  246.         xmit( ch ); 
  247.     End; 
  248.  
  249.     IF( buff_Count > 0 ) THEN 
  250.     Begin 
  251.       { Display a character from the buffer. } 
  252.       writech; 
  253.  
  254.       { IF the buffer is more than 75% full, then send XOFF char ASAP. } 
  255.       IF( (buff_Count / (MAX_BUFF * 1.0)) > BUFF_FULL ) THEN 
  256.       Begin
  257.         { Wait until a character can be sent. } 
  258.         WHILE( NOT can_xmit ) DO 
  259.           ; 
  260.  
  261.         { Send the XOFF control code. } 
  262.         xmit( XOFF_CH ); 
  263.  
  264.         { Indicate that an XON can be sent anytime. } 
  265.         send_xon := FALSE; 
  266.       End; 
  267.  
  268.       { IF the buffer is less than 50% full, then send XON char ASAP. } 
  269.       IF( ((buff_Count / (MAX_BUFF * 1.0)) < BUFF_EMPT) AND 
  270.            (NOT send_xon) ) THEN 
  271.       Begin 
  272.         { Wait until a character can be sent. } 
  273.         WHILE( NOT can_xmit ) DO 
  274.           ; 
  275.  
  276.         { Send the XON control code. } 
  277.         xmit( XON_CH ); 
  278.  
  279.         { An XON control code has been sent. } 
  280.         send_xon := TRUE; 
  281.       End; 
  282.     End; 
  283.   Until( done ); 
  284. End; 
  285.  
  286. FUNCTION Value( NumS : STRING ) : LONGINT;
  287. VAR 
  288.   O, M, S, C : LONGINT; 
  289.  
  290. Begin 
  291.   S := 0; 
  292.   M := 1; 
  293.  
  294.   FOR C := Length(NumS) DOWNTO 1 DO 
  295.   Begin 
  296.     O := Ord( NumS[C] ); 
  297.  
  298.     IF NumS[C] IN ['0'..'9'] THEN 
  299.     Begin 
  300.       INC( S, M * (O - 48) ); 
  301.       M := M * 10; 
  302.     End; 
  303.   End; 
  304.  
  305.   Value := S; 
  306. End; 
  307.  
  308. FUNCTION UCase( S : STRING ) : STRING; 
  309. VAR 
  310.   C : BYTE; 
  311.  
  312. Begin 
  313.   FOR C := 1 TO Length(S) DO 
  314.     S[C] := UpCase( S[C] ); 
  315.  
  316.   UCase := S; 
  317. End; 
  318.  
  319. VAR 
  320.   Count,                { Simple Counter.                    } 
  321.   baud,                 { Baud rate.                         } 
  322.   parity,               { Parity    - NONE, EVEN, ODD.       } 
  323.   data_bits,            { Data bits - 7, 8.                  } 
  324.   stop_bits  : INTEGER; { Stop bits - 1, 2.                  } 
  325.   temp, 
  326.   current    : RecLinkPtr; 
  327.   SecParam   : STRING; 
  328.   save_int   : POINTER; 
  329.  
  330. Begin 
  331.   buff_Count := 0;
  332.   xon        := TRUE;
  333.  
  334.   { 4 command line arguments (include program name) are required. }
  335.   IF( ParamCount <> 4 ) THEN
  336.     ShowUsage;
  337.  
  338.   { The first command line argument is specified to be the baud rate. }
  339.   baud := Value( ParamStr( 1 ) );
  340.  
  341.   { Convert second argument to upper case so first letter can be checked
  342.     for parity. }
  343.   SecParam := ParamStr( 2 );
  344.   SecParam := UCase( SecParam );
  345.  
  346.   { Check first character of 2nd command line parameter for parity. }
  347.   CASE SecParam[1] OF
  348.     'N' : parity := NONE;
  349.     'O' : parity := ODD;
  350.     'E' : parity := EVEN;
  351.   ELSE
  352.     ShowUsage;
  353.   End;
  354.  
  355.   rec_buff := NIL;
  356.   {  Allocate enough memory for MAX_BUFF characters (New is not re-entrant).
  357.   } 
  358.   FOR Count := 0 TO MAX_BUFF - 1 DO 
  359.   Begin 
  360.     New( temp ); 
  361.  
  362.     temp^.next     := NIL; 
  363.     temp^.rec_char := #0; 
  364.  
  365.     IF( rec_buff = NIL ) THEN 
  366.       rec_buff := temp 
  367.     ELSE 
  368.     Begin 
  369.       current := rec_buff; 
  370.  
  371.       WHILE( current^.next <> NIL ) DO 
  372.         current := current^.next; 
  373.  
  374.       current^.next := temp; 
  375.     End; 
  376.   End; 
  377.  
  378.   {  Create a circular buffer by pointing the last element in the list to 
  379.      the start (head) of the list. 
  380.   } 
  381.   temp^.next := rec_buff; 
  382.  
  383.   { Point to the first character to write within the buffer. } 
  384.   to_write := rec_buff; 
  385.  
  386.   data_bits := Value( ParamStr( 3 ) );
  387.  
  388.   stop_bits := Value( ParamStr( 4 ) ); 
  389.  
  390.   getintvec( COM_INT, save_int ); 
  391.  
  392.   { Set vector = $0C to new interrupt routine. } 
  393.   SetIntVec( COM_INT, Addr( receive_ch ) ); 
  394.  
  395.   { Initialize the modem according to the command line parameters. } 
  396.   setup( baud, parity, data_bits, stop_bits ); 
  397.  
  398.   { Interrupt on received character. } 
  399.   Port[ COM1 + IER ] := DATA_REC; 
  400.  
  401.   { Enable interrupts }
  402.   Port[ COM1 + MCR ] := INT_ENABL; 
  403.  
  404.   { Set PIC control register to enable IRQ4. } 
  405.   Port[ PIC_CNTL ] := Port[ PIC_CNTL ] AND IRQ4_MASK; 
  406.  
  407.   { Set MSR such that CTS and DSR are high. } 
  408.   Port[ COM1 + MSR ] := CTS_DSR; 
  409.  
  410.   ClrScr; 
  411.   WriteLn( 'Type Control-D at any time to quit.' ); 
  412.  
  413.   { Repeat Serial communications. } 
  414.   Serial; 
  415.  
  416.   { Disable interrupts } 
  417.   Port[ COM1 + IER ] := 0; 
  418.  
  419.   { Set PIC control register to disable IRQ4. } 
  420.   Port[ PIC_CNTL ] := Port[ PIC_CNTL ] AND (NOT IRQ4_MASK); 
  421.  
  422.   { Set vector = $0C to old interrupt routine. } 
  423.   SetIntVec( COM_INT, save_int ); 
  424.  
  425.   { Deallocate all the memory used in the buffer. } 
  426.   FOR Count := 0 TO MAX_BUFF - 1 DO 
  427.   Begin 
  428.     temp     := rec_buff; 
  429.     rec_buff := rec_buff^.next; 
  430.  
  431.     Dispose( temp ); 
  432.   End; 
  433. End. 
  434.